home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / pixie.cpt / Pixie Scheme ƒ / Goodies / Checkbook.s next >
Encoding:
Text File  |  1991-01-01  |  4.7 KB  |  142 lines
  1. ;     Elementary checkbook╨balancer.  Keeps track of the number of pennies
  2. ; in your account, as a 32-bit signed integer, and therefore will fail
  3. ; whenever your account balance much exceeds 20 million dollars (or when
  4. ; you are overdrawn by that amount).
  5. ;
  6. ;     If you have more than 20 million dollars in your checkbook, you
  7. ; can presumably afford better software.  If you are more than 20 million
  8. ; dollars overdrawn, I doubt that better software will help.
  9.  
  10.  
  11. ;;;     The following symbols will be rebound globally to appropriate
  12. ;;; functions, when "make-checkbook" is called.
  13.  
  14. (define c #f)     ;; Account for writing a check, eg (c 49.95).
  15. (define d #f)     ;; Account for making a deposit, eg (d 1000).
  16. (define l #f)     ;; Print ledger: (l).
  17. (define u #f)     ;; Undo last "c" or "d":  (u).
  18.  
  19.  
  20. ;;;     MAKE-CHECKBOOK     Create a checkbook with the given balance.
  21.  
  22. (e::define-no-compile (make-checkbook brought-forward)
  23.   ;;
  24.   ;; Compilation takes a loooooong time ╔
  25.   ;;
  26.   (let* 
  27.     ((balance brought-forward)
  28.      (ledger (list (list 'brought-forward #f brought-forward)))
  29.      (debit (lambda (amount) (set! balance (- balance amount))))
  30.      (credit (lambda (amount) (set! balance (+ balance amount))))
  31.      (enter (lambda (transaction)
  32.                (set! ledger (cons transaction ledger))) )
  33.      (remove-last-transaction (lambda () 
  34.                                 (set! ledger (cdr ledger)) ) )
  35.      (last-transaction (lambda () (car ledger)))
  36.      (make-check-transaction (lambda (amount)
  37.                                (list 'check amount balance) ) )
  38.      (make-deposit-transaction (lambda (amount)
  39.                                  (list 'deposit amount balance) ) )
  40.      )
  41.     (set! c
  42.           (lambda (amount)
  43.             (debit amount)
  44.             (enter (make-check-transaction amount))                          
  45.             (transaction-string (last-transaction)) ) )
  46.     (set! d (lambda (amount)
  47.               (credit amount)
  48.               (enter (make-deposit-transaction amount))
  49.               (transaction-string (last-transaction)) ) )
  50.     (set! u (lambda ()
  51.               (let ((removed (last-transaction)))
  52.                 (remove-last-transaction)
  53.                 (set! balance (transaction-balance (last-transaction)))
  54.                 (transaction-string removed)
  55.                 #t ) ) )
  56.     (set! l (lambda ()
  57.               (display "   Check     Deposit    Balance") (newline)
  58.               (display " =========  =========  =========") (newline)
  59.               (for-each (lambda (transaction)
  60.                           (display (transaction-string transaction))
  61.                           (newline) )
  62.                         (reverse ledger) )
  63.               #t ) )
  64.     ) )
  65.  
  66. (define transaction-amount cadr)
  67.  
  68. (define transaction-balance caddr)
  69.  
  70. (define transaction-type car)
  71.  
  72. (e::define-no-compile (transaction-string transaction)
  73.   (let ((type (car transaction)))
  74.     (cond ((equal? type 'check)
  75.            (string-append 
  76.             (dollar->string (transaction-amount transaction))
  77.             "           "
  78.             (dollar->string (transaction-balance transaction)) ) )
  79.           ((equal? type 'deposit)
  80.            (string-append 
  81.             "           "
  82.             (dollar->string (transaction-amount transaction))
  83.             (dollar->string (transaction-balance transaction)) ) )
  84.           ((equal? type 'brought-forward)
  85.            (string-append
  86.             "                      " 
  87.             (dollar->string (transaction-balance transaction)) ) )
  88.           (else 
  89.            (checkbook-error "Unknown transaction type:" type) ) )
  90.     ) )
  91.  
  92. (e::define-no-compile (string-index char string)
  93.   (do ((i 0 (+ i 1))
  94.        (l (string-length string))
  95.        (found? #f) )
  96.       ((or found? 
  97.            (>= i l) )
  98.        found? )
  99.       (if (char=? (string-ref string i) char)
  100.           (set! found? i) ) ) )
  101.  
  102. (e::define-no-compile (dollar->string x)
  103.   (let*
  104.     ((sign-string 
  105.       (if (positive? x)
  106.           " "
  107.           "-" ) )
  108.      (dollars (floor (abs x)))
  109.      (dollar-string (number->string dollars '(int)))
  110.      (cents (* 100 (- (abs x) dollars)))
  111.      (cent-string (substring (number->string (+ 100.5 cents) '(fix 1)) 1 3))
  112.      (leading-blanks
  113.       (-
  114.        9
  115.        (+ 1 
  116.           (string-length dollar-string) 
  117.           1 
  118.           (string-length cent-string)
  119.           )
  120.        ) )
  121.      )
  122.     (if (negative? leading-blanks)
  123.         (checkbook-error "Number too large:" x) )
  124.     (let ((blank-string (make-string (+ leading-blanks 1) #\space)))
  125.       (string-append 
  126.        blank-string 
  127.        sign-string 
  128.        dollar-string
  129.        "." 
  130.        cent-string
  131.        " " ) ) ) )
  132.  
  133. (e::define-no-compile (checkbook-error message x)
  134.   (begin (newline)
  135.          (display "Error: ")
  136.          (display message)
  137.          (display " ")
  138.          (display x)
  139.          (newline) ) )
  140.  
  141.  
  142.